read_csv(here("data/character_list5.csv"),
progress = FALSE,
col_types = cols(
script_id = col_integer(),
imdb_character_name = col_character(),
words = col_integer(),
gender = col_character(),
age = col_character()
)) %>%
mutate(age = as.numeric(age)) -> characters_list
characters_list %>%
glimpse()
Observations: 23,048
Variables: 5
$ script_id <int> 280, 280, 280, 280, 280, 280, 280, 623, 623, 623, 623, 623, 623...
$ imdb_character_name <chr> "betty", "carolyn johnson", "eleanor", "francesca johns", "madg...
$ words <int> 311, 873, 138, 2251, 190, 723, 1908, 328, 409, 347, 2020, 366, ...
$ gender <chr> "f", "f", "f", "f", "f", "m", "m", "m", "f", "m", "m", "m", "m"...
$ age <dbl> 35, NA, NA, 46, 46, 38, 65, NA, 28, NA, 58, 53, 25, 39, 33, NA,...
read_csv(here("data/meta_data7.csv"),
progress = FALSE,
col_types = cols(
script_id = col_integer(),
imdb_id = col_character(),
title = col_character(),
year = col_integer(),
gross = col_integer(),
lines_data = col_character()
)) -> meta_data
meta_data %>%
glimpse()
Observations: 2,000
Variables: 6
$ script_id <int> 1534, 1512, 1514, 1517, 1520, 6537, 3778, 623, 1525, 6030, 625, 1509, 85...
$ imdb_id <chr> "tt1022603", "tt0147800", "tt0417385", "tt2024544", "tt1542344", "tt0450...
$ title <chr> "(500) Days of Summer", "10 Things I Hate About You", "12 and Holding", ...
$ year <int> 2009, 1999, 2005, 2013, 2010, 2007, 1992, 2001, 2009, 2013, 1968, 2009, ...
$ gross <int> 37, 65, NA, 60, 20, 91, 15, 37, 74, 80, 376, 192, 98, 204, 19, 59, 67, 3...
$ lines_data <chr> "74354452567747744433425777756577444344445644567454336755345277773423754...
left_join(characters_list,
meta_data,
by=c("script_id")) %>%
group_by(title, year) %>%
drop_na(gross) %>%
ungroup() -> scripts_data
scripts_data %>%
glimpse()
Observations: 19,387
Variables: 10
$ script_id <int> 280, 280, 280, 280, 280, 280, 280, 623, 623, 623, 623, 623, 623...
$ imdb_character_name <chr> "betty", "carolyn johnson", "eleanor", "francesca johns", "madg...
$ words <int> 311, 873, 138, 2251, 190, 723, 1908, 328, 409, 347, 2020, 366, ...
$ gender <chr> "f", "f", "f", "f", "f", "m", "m", "m", "f", "m", "m", "m", "m"...
$ age <dbl> 35, NA, NA, 46, 46, 38, 65, NA, 28, NA, 58, 53, 25, 39, 33, NA,...
$ imdb_id <chr> "tt0112579", "tt0112579", "tt0112579", "tt0112579", "tt0112579"...
$ title <chr> "The Bridges of Madison County", "The Bridges of Madison County...
$ year <int> 1995, 1995, 1995, 1995, 1995, 1995, 1995, 2001, 2001, 2001, 200...
$ gross <int> 142, 142, 142, 142, 142, 142, 142, 37, 37, 37, 37, 37, 37, 37, ...
$ lines_data <chr> "43320234343434432034334343344334343434344343443443334344434443...
scripts_data %>%
group_by(title,year) %>%
unique() %>%
ggplot(aes(x=words,
y=(..count..)/sum(..count..))) +
geom_histogram(binwidth = 250,
boundary = 0,
fill = "grey",
color = "black")
scripts_data %>%
group_by(title,year) %>%
unique() %>%
ggplot(aes(x="",
y=words)) +
geom_violin(fill="grey",
width=0.5)
scripts_data %>%
group_by(title, year) %>%
mutate(fem_prop = (sum(gender == "f") / n()),
man_prop = (1 - fem_prop)) %>%
ungroup() -> scripts_data
scripts_data %>%
select(title,
year,
fem_prop,
man_prop) %>%
sample_n(10)
scripts_data %>%
group_by(title,year) %>%
unique() %>%
ggplot(aes(x=fem_prop,
y=(..count..)/sum(..count..))) +
geom_histogram(binwidth = 0.05,
boundary = 0,
fill = "grey",
color = "black")
scripts_data %>%
group_by(title,year) %>%
unique() %>%
ggplot(aes(x="",
y=fem_prop)) +
geom_violin(fill="grey",
width=0.5)
scripts_data %>%
group_by(title,year) %>%
unique() %>%
ggplot(aes(x=year)) +
geom_bar(fill = "grey",
color = "black")
scripts_data %>%
group_by(title,year) %>%
unique() %>%
ggplot(aes(x="",
y=year)) +
geom_violin(fill="grey",
width=0.5)
scripts_data %>%
mutate(fem_words = ifelse(gender == "f",words,0),
man_words = ifelse(gender == "m",words,0)) %>%
group_by(title, year) %>%
mutate(mean_fem_words = ifelse(sum(gender == "f") == 0, 0, sum(fem_words)/sum(gender == "f")),
mean_man_words = ifelse(sum(gender == "m") == 0, 0, sum(man_words)/sum(gender == "m"))) %>%
ungroup() -> scripts_data
scripts_data %>%
select(title,
year,
mean_fem_words,
mean_man_words) %>%
sample_n(10)
scripts_data %>%
group_by(title,year) %>%
unique() %>%
filter(!mean_fem_words == 0) %>%
ggplot(aes(x=mean_fem_words,
y=(..count..)/sum(..count..))) +
geom_histogram(binwidth = 250,
boundary = 0,
fill = "grey",
color = "black")
scripts_data %>%
group_by(title,year) %>%
unique() %>%
filter(!mean_fem_words == 0) %>%
ggplot(aes(x="",
y=mean_fem_words)) +
geom_violin(fill="grey",
width=0.5)
scripts_data %>%
group_by(title,year) %>%
unique() %>%
filter(!mean_man_words == 0) %>%
ggplot(aes(x=mean_man_words,
y=(..count..)/sum(..count..))) +
geom_histogram(binwidth = 250,
boundary = 0,
fill = "grey",
color = "black")
scripts_data %>%
group_by(title,year) %>%
unique() %>%
filter(!mean_man_words == 0) %>%
ggplot(aes(x="",
y=mean_man_words)) +
geom_violin(fill="grey",
width=0.5)
scripts_data %>%
group_by(title) %>%
slice(1) %>%
unique() %>%
ungroup() %>%
select(title,
gross,
fem_prop,
mean_fem_words,
mean_man_words) -> data
select(data, -title) %>%
mutate_all(funs(scale)) -> scaled_data
scaled_data %>%
sample_n(10)
A GAP compara a solução do agrupamento com cada k com a solução em um dataset onde não há estrutura de grupos.
plot_clusgap = function(clusgap, title="Gap Statistic calculation results"){
require("ggplot2")
gstab = data.frame(clusgap$Tab, k=1:nrow(clusgap$Tab))
p = ggplot(gstab, aes(k, gap)) + geom_line() + geom_point(size=5)
p = p + geom_errorbar(aes(ymax=gap+SE.sim, ymin=gap-SE.sim), width = .2)
p = p + ggtitle(title)
return(p)
}
gaps <- scaled_data %>%
clusGap(FUN = kmeans,
nstart = 20,
K.max = 8,
B = 200,
iter.max=30)
Clustering k = 1,2,..., K.max (= 8): .. done
Bootstrapping, b = 1,2,..., B (= 200) [one "." per sample]:
.................................................. 50
.................................................. 100
.................................................. 150
.................................................. 200
plot_clusgap(gaps)
set.seed(123)
# Compute and plot wss for k = 2 to k = 15.
k.max <- 15
wss <- sapply(1:k.max,
function(k){kmeans(scaled_data, k, nstart=50,iter.max = 15 )$tot.withinss})
plot(1:k.max, wss,
type="b", pch = 19, frame = FALSE,
xlab="Number of clusters K",
ylab="Total within-clusters sum of squares")
data(varespec)
dis = dist(scaled_data)^2
res = kmeans(scaled_data,3)
sil = silhouette (res$cluster, dis)
plot(sil)
fitting ...
|
| | 0%
|
|= | 1%
|
|== | 2%
|
|== | 3%
|
|=== | 3%
|
|=== | 4%
|
|==== | 4%
|
|==== | 5%
|
|===== | 6%
|
|====== | 7%
|
|======= | 8%
|
|======= | 9%
|
|======== | 9%
|
|========= | 10%
|
|========= | 11%
|
|========== | 11%
|
|========== | 12%
|
|=========== | 12%
|
|=========== | 13%
|
|============ | 14%
|
|============= | 15%
|
|============= | 16%
|
|============== | 16%
|
|============== | 17%
|
|=============== | 17%
|
|=============== | 18%
|
|================ | 18%
|
|================ | 19%
|
|================= | 19%
|
|================= | 20%
|
|================== | 20%
|
|================== | 21%
|
|=================== | 22%
|
|==================== | 23%
|
|==================== | 24%
|
|===================== | 24%
|
|===================== | 25%
|
|====================== | 25%
|
|====================== | 26%
|
|======================= | 27%
|
|======================== | 27%
|
|======================== | 28%
|
|========================= | 29%
|
|========================== | 30%
|
|========================== | 31%
|
|=========================== | 31%
|
|=========================== | 32%
|
|============================ | 32%
|
|============================ | 33%
|
|============================= | 33%
|
|============================= | 34%
|
|============================== | 35%
|
|=============================== | 36%
|
|================================ | 37%
|
|================================= | 38%
|
|================================= | 39%
|
|================================== | 39%
|
|================================== | 40%
|
|=================================== | 40%
|
|=================================== | 41%
|
|==================================== | 42%
|
|===================================== | 43%
|
|===================================== | 44%
|
|====================================== | 44%
|
|====================================== | 45%
|
|======================================= | 45%
|
|======================================== | 46%
|
|======================================== | 47%
|
|========================================= | 47%
|
|========================================= | 48%
|
|========================================== | 48%
|
|========================================== | 49%
|
|=========================================== | 50%
|
|============================================ | 51%
|
|============================================ | 52%
|
|============================================= | 52%
|
|============================================= | 53%
|
|============================================== | 53%
|
|============================================== | 54%
|
|=============================================== | 55%
|
|================================================ | 55%
|
|================================================ | 56%
|
|================================================= | 56%
|
|================================================= | 57%
|
|================================================== | 58%
|
|=================================================== | 59%
|
|=================================================== | 60%
|
|==================================================== | 60%
|
|==================================================== | 61%
|
|===================================================== | 61%
|
|===================================================== | 62%
|
|====================================================== | 63%
|
|======================================================= | 64%
|
|======================================================== | 65%
|
|========================================================= | 66%
|
|========================================================= | 67%
|
|========================================================== | 67%
|
|========================================================== | 68%
|
|=========================================================== | 68%
|
|=========================================================== | 69%
|
|============================================================ | 69%
|
|============================================================ | 70%
|
|============================================================= | 71%
|
|============================================================== | 72%
|
|============================================================== | 73%
|
|=============================================================== | 73%
|
|================================================================ | 74%
|
|================================================================ | 75%
|
|================================================================= | 75%
|
|================================================================= | 76%
|
|================================================================== | 76%
|
|================================================================== | 77%
|
|=================================================================== | 78%
|
|==================================================================== | 79%
|
|==================================================================== | 80%
|
|===================================================================== | 80%
|
|===================================================================== | 81%
|
|====================================================================== | 81%
|
|====================================================================== | 82%
|
|======================================================================= | 82%
|
|======================================================================= | 83%
|
|======================================================================== | 83%
|
|======================================================================== | 84%
|
|========================================================================= | 84%
|
|========================================================================= | 85%
|
|========================================================================== | 86%
|
|=========================================================================== | 87%
|
|=========================================================================== | 88%
|
|============================================================================ | 88%
|
|============================================================================ | 89%
|
|============================================================================= | 89%
|
|============================================================================= | 90%
|
|============================================================================== | 91%
|
|=============================================================================== | 91%
|
|=============================================================================== | 92%
|
|================================================================================ | 93%
|
|================================================================================= | 94%
|
|================================================================================== | 95%
|
|================================================================================== | 96%
|
|=================================================================================== | 96%
|
|=================================================================================== | 97%
|
|==================================================================================== | 97%
|
|==================================================================================== | 98%
|
|===================================================================================== | 99%
|
|======================================================================================| 100%
Bayesian Information Criterion (BIC):
EII VII EEI VEI EVI VVI EEE EVE VEE
1 -18865.22 -18865.22 -18887.46 -18887.46 -18887.46 -18887.46 -18610.48 -18610.48 -18610.48
2 -18262.02 -16988.77 -18088.63 -16709.17 -17196.30 -16364.22 -17998.98 -17581.43 -16556.64
3 -18200.17 -16450.13 -17725.19 -16291.72 -16454.57 -15698.71 -17896.01 -16432.33 -16120.76
4 -17473.88 -16185.65 -17036.25 -16101.97 -15921.11 -15392.05 -17932.51 -15823.41 -15936.34
5 -16980.30 -16049.44 -16986.57 -15796.79 -15834.37 -14956.79 -17321.75 -15712.44 -15852.69
6 -16972.30 -15824.88 -17021.85 -15749.23 -15710.02 -14873.43 -16914.70 -15464.39 -15617.91
7 -16668.28 -15775.42 -16503.67 -15609.43 -15420.13 -14753.73 -16947.67 -15367.99 -15540.84
8 -16706.92 -15736.25 -16539.42 -15527.14 -15377.54 -14728.17 -16983.81 -15306.82 -15532.64
9 -16618.78 -15596.71 -16570.05 -15386.84 -15384.21 -14714.68 -16548.00 -15278.38 -15399.31
10 -16653.20 -15495.69 -16607.27 -15340.75 -15270.18 NA -16585.13 -15250.94 -15289.93
11 -16690.01 -15511.87 -16644.35 -15336.24 -15251.42 NA -16623.16 -15215.33 -15281.81
12 -16727.33 -15525.67 -16681.40 -15359.94 -15196.26 NA -16660.21 -15134.28 -15281.13
13 -16372.34 -15477.71 -16315.78 -15332.31 NA NA -16674.26 -15193.80 -15287.63
14 -16409.35 -15458.67 -16352.56 -15337.87 NA NA -16711.24 -15112.53 -15317.18
15 -16425.49 -15449.87 -16301.45 -15311.57 NA NA -16326.90 -15066.55 -15283.96
VVE EEV VEV EVV VVV
1 -18610.48 -18610.48 -18610.48 -18610.48 -18610.48
2 -16380.77 -17178.37 -16089.82 -17131.66 -16081.48
3 -15938.44 -16749.13 -15720.33 -16647.31 -15585.70
4 -15685.08 -16380.53 -15414.24 -16078.33 -15286.91
5 -15551.47 -16262.19 -15266.60 -15979.00 -15073.02
6 -15444.62 -15901.60 -15201.81 -15622.14 -14904.70
7 -15182.10 -15830.44 -15065.93 -15488.26 -14896.85
8 -15163.46 -15658.25 -15041.34 -15438.44 -14832.57
9 -15197.77 -15726.99 -14986.94 -15445.79 -14822.44
10 -15110.11 -15650.00 -14963.05 -15401.84 NA
11 -15027.53 -15546.12 -15001.81 -15404.45 NA
12 -15015.23 -15429.65 -14973.12 -15351.73 NA
13 -15017.20 -15519.06 -14989.55 -15499.06 NA
14 -15006.81 -15452.36 -15064.14 -15436.73 NA
15 -15010.20 -15567.56 -15053.71 -15430.25 NA
Top 3 models based on the BIC criterion:
VVI,9 VVI,8 VVI,7
-14714.68 -14728.17 -14753.73
plot(d_clust$BIC)
nb <- NbClust(scaled_data, diss=NULL, distance = "euclidean",
min.nc=2, max.nc=5, method = "kmeans",
index = "all", alphaBeale = 0.1)
*** : The Hubert index is a graphical method of determining the number of clusters.
In the plot of Hubert index, we seek a significant knee that corresponds to a
significant increase of the value of the measure i.e the significant peak in Hubert
index second differences plot.
*** : The D index is a graphical method of determining the number of clusters.
In the plot of D index, we seek a significant knee (the significant peak in Dindex
second differences plot) that corresponds to a significant increase of the value of
the measure.
*******************************************************************
* Among all indices:
* 5 proposed 2 as the best number of clusters
* 10 proposed 3 as the best number of clusters
* 1 proposed 4 as the best number of clusters
* 7 proposed 5 as the best number of clusters
***** Conclusion *****
* According to the majority rule, the best number of clusters is 3
*******************************************************************
hist(nb$Best.nc[1,], breaks = max(na.omit(nb$Best.nc[1,])))
# toclust = x %>%
# rownames_to_column(var = "language") %>%
# select(1:5)
# dists = toclust %>%
# select(-language) %>%
# dist() # só para plotar silhouetas depois
# km = toclust %>%
# select(-language) %>%
# kmeans(centers = n_clusters, nstart = 20)
# km %>%
# augment(toclust) %>%
# gather(key = "variável", value = "valor", -language, -.cluster) %>%
# ggplot(aes(x = `variável`, y = valor, group = language, colour = .cluster)) +
# geom_point(alpha = 0.2) +
# geom_line(alpha = .5) +
# facet_wrap(~ .cluster)
library(GGally)
Attaching package: ‘GGally’
The following object is masked from ‘package:dplyr’:
nasa
data(crabs, package = "MASS")
ggparcoord(crabs, columns = 4:8, groupColumn = "sp")
library(GGally)
x <- rnorm(100)
d1 <- data.frame(x1 = x, x2 = rnorm(x), x3 = x)
d2 <- mutate(d1, x3 = -x)
ggparcoord(d1)
library(lattice)
parallelplot(d1)
scaled_data %>%
kmeans(3, nstart=100) -> km
a <- autoplot(km, data=scaled_data, frame = TRUE)
ggplotly(a)